VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ScrollBar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
DefLng H

Public SB_TYPE As Integer 'SB_HORZ or SB_VERT
Private m_SmallChange As Integer
Private m_LargeChange As Integer
Public hm_hWnd
Private hm_Min
Private hm_Max

Public Function Change(wParam As Long) As Integer
Dim iChange As Integer
Dim lOldPos As Long
Dim lNewPos As Long
    lOldPos = GetScrollPos(hm_hWnd, SB_TYPE)
    Select Case wParam And &HFFFF&
        Case SB_LINEUP: iChange = -m_SmallChange
        Case SB_LINEDOWN: iChange = m_SmallChange
        Case SB_PAGEUP: iChange = -m_LargeChange
        Case SB_PAGEDOWN: iChange = m_LargeChange
        Case SB_THUMBTRACK, SB_THUMBPOSITION:
            iChange = wParam \ &H10000 - lOldPos
        Case Else
            Exit Function
    End Select
    If iChange Then
        lNewPos = lOldPos + iChange
        If lNewPos < hm_Min Then lNewPos = hm_Min
        If lNewPos > hm_Max Then lNewPos = hm_Max
        iChange = lOldPos - lNewPos
        If iChange Then SetScrollPos hm_hWnd, SB_TYPE, lNewPos, 1
    End If
    Change = iChange
End Function

Public Property Let Value(NewValue As Integer)
    SetScrollPos hm_hWnd, SB_TYPE, NewValue, 1
End Property

Public Property Get Value() As Integer
    Value = GetScrollPos(hm_hWnd, SB_TYPE)
End Property

Public Property Let hWnd(Handle As Long)
    hm_hWnd = Handle
    If hm_hWnd Then
        GetScrollRange hm_hWnd, SB_TYPE, hm_Min, hm_Max
    End If
End Property

Public Property Get hWnd() As Long
    hWnd = hm_hWnd
End Property

Public Property Let SmallChange(Value As Integer)
    '>32767 taken care of by integer type
    If Value < 1 Then Err.Raise 380 'Invalid property value.
    m_SmallChange = Value
End Property

Public Property Get SmallChange() As Integer
    SmallChange = m_SmallChange
End Property

Public Property Let LargeChange(Value As Integer)
    '>32767 taken care of by integer type
    If Value < 1 Then Err.Raise 380 'Invalid property value.
    m_LargeChange = Value
End Property

Public Property Get LargeChange() As Integer
    LargeChange = m_LargeChange
End Property

Public Property Let Max(Value As Integer)
Dim lValue As Long
    '>32767 taken care of by integer type
    If Value < 0 Then Err.Raise 380 'Invalid property value.
    lValue = Value
    SetScrollRange hm_hWnd, SB_TYPE, hm_Min, lValue, 1
    hm_Max = Value
End Property

Public Property Get Max() As Integer
    Max = hm_Max
End Property

Public Property Let Min(Value As Integer)
Dim lValue As Long
    '>32767 taken care of by integer type
    If Value < 0 Then Err.Raise 380 'Invalid property value.
    lValue = Value
    SetScrollRange hm_hWnd, SB_TYPE, lValue, hm_Max, 1
    hm_Min = Value
End Property

Public Property Get Min() As Integer
    Min = hm_Min
End Property

Private Sub Class_Initialize()
    m_SmallChange = 1
    m_LargeChange = 1
    hm_Min = 0
    hm_Max = 100
End Sub
